home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / RICHIMPL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-30  |  10.9 KB  |  427 lines

  1. unit RichImpl;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, DelLib, ComCtrls;
  8.  
  9. type
  10.   TRichEditX = class(TActiveXControl, IRichEditX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TRichEdit;
  14.     FEvents: IRichEditXEvents;
  15.     procedure ChangeEvent(Sender: TObject);
  16.     procedure KeyPressEvent(Sender: TObject; var Key: Char);
  17.     procedure ProtectChangeEvent(Sender: TObject; StartPos, EndPos: Integer;
  18.       var AllowChange: Boolean);
  19.     procedure SaveClipboardEvent(Sender: TObject; NumObjects,
  20.       NumChars: Integer; var SaveClipboard: Boolean);
  21.     procedure SelectionChangeEvent(Sender: TObject);
  22.   protected
  23.     { Protected declarations }
  24.     procedure InitializeControl; override;
  25.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  26.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  27.     function Get_Color: TColor; safecall;
  28.     function Get_Ctl3D: WordBool; safecall;
  29.     function Get_Cursor: Smallint; safecall;
  30.     function Get_DragCursor: Smallint; safecall;
  31.     function Get_Enabled: WordBool; safecall;
  32.     function Get_Font: Font; safecall;
  33.     function Get_HideScrollBars: WordBool; safecall;
  34.     function Get_HideSelection: WordBool; safecall;
  35.     function Get_ImeName: WideString; safecall;
  36.     function Get_Lines: IStrings; safecall;
  37.     function Get_MaxLength: Integer; safecall;
  38.     function Get_Modified: WordBool; safecall;
  39.     function Get_ParentColor: WordBool; safecall;
  40.     function Get_PlainText: WordBool; safecall;
  41.     function Get_ReadOnly: WordBool; safecall;
  42.     function Get_SelLength: Integer; safecall;
  43.     function Get_SelStart: Integer; safecall;
  44.     function Get_SelText: WideString; safecall;
  45.     function Get_Text: WideString; safecall;
  46.     function Get_Visible: WordBool; safecall;
  47.     function Get_WantReturns: WordBool; safecall;
  48.     function Get_WantTabs: WordBool; safecall;
  49.     function Get_WordWrap: WordBool; safecall;
  50.     procedure AboutBox; safecall;
  51.     procedure Clear; safecall;
  52.     procedure ClearSelection; safecall;
  53.     procedure CopyToClipboard; safecall;
  54.     procedure CutToClipboard; safecall;
  55.     procedure PasteFromClipboard; safecall;
  56.     procedure Print(const Caption: WideString); safecall;
  57.     procedure SelectAll; safecall;
  58.     procedure Set_Color(Value: TColor); safecall;
  59.     procedure Set_Ctl3D(Value: WordBool); safecall;
  60.     procedure Set_Cursor(Value: Smallint); safecall;
  61.     procedure Set_DragCursor(Value: Smallint); safecall;
  62.     procedure Set_Enabled(Value: WordBool); safecall;
  63.     procedure Set_Font(const Value: Font); safecall;
  64.     procedure Set_HideScrollBars(Value: WordBool); safecall;
  65.     procedure Set_HideSelection(Value: WordBool); safecall;
  66.     procedure Set_ImeName(const Value: WideString); safecall;
  67.     procedure Set_Lines(const Value: IStrings); safecall;
  68.     procedure Set_MaxLength(Value: Integer); safecall;
  69.     procedure Set_Modified(Value: WordBool); safecall;
  70.     procedure Set_ParentColor(Value: WordBool); safecall;
  71.     procedure Set_PlainText(Value: WordBool); safecall;
  72.     procedure Set_ReadOnly(Value: WordBool); safecall;
  73.     procedure Set_SelLength(Value: Integer); safecall;
  74.     procedure Set_SelStart(Value: Integer); safecall;
  75.     procedure Set_SelText(const Value: WideString); safecall;
  76.     procedure Set_Text(const Value: WideString); safecall;
  77.     procedure Set_Visible(Value: WordBool); safecall;
  78.     procedure Set_WantReturns(Value: WordBool); safecall;
  79.     procedure Set_WantTabs(Value: WordBool); safecall;
  80.     procedure Set_WordWrap(Value: WordBool); safecall;
  81.   end;
  82.  
  83. implementation
  84. uses RichPg;
  85. { TRichEditX }
  86.  
  87. procedure TRichEditX.InitializeControl;
  88. begin
  89.   FDelphiControl := Control as TRichEdit;
  90.   FDelphiControl.OnChange := ChangeEvent;
  91.   FDelphiControl.OnKeyPress := KeyPressEvent;
  92.   FDelphiControl.OnProtectChange := ProtectChangeEvent;
  93.   FDelphiControl.OnSaveClipboard := SaveClipboardEvent;
  94.   FDelphiControl.OnSelectionChange := SelectionChangeEvent;
  95. end;
  96.  
  97. procedure TRichEditX.EventSinkChanged(const EventSink: IUnknown);
  98. begin
  99.   FEvents := EventSink as IRichEditXEvents;
  100. end;
  101.  
  102. procedure TRichEditX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  103. begin
  104.   { Define property pages here.  Property pages are defined by calling
  105.     DefinePropertyPage with the class id of the page.  For example,
  106.       DefinePropertyPage(Class_RichEditXPage); }
  107. end;
  108.  
  109. function TRichEditX.Get_Color: TColor;
  110. begin
  111.   Result := FDelphiControl.Color;
  112. end;
  113.  
  114. function TRichEditX.Get_Ctl3D: WordBool;
  115. begin
  116.   Result := FDelphiControl.Ctl3D;
  117. end;
  118.  
  119. function TRichEditX.Get_Cursor: Smallint;
  120. begin
  121.   Result := Smallint(FDelphiControl.Cursor);
  122. end;
  123.  
  124. function TRichEditX.Get_DragCursor: Smallint;
  125. begin
  126.   Result := Smallint(FDelphiControl.DragCursor);
  127. end;
  128.  
  129. function TRichEditX.Get_Enabled: WordBool;
  130. begin
  131.   Result := FDelphiControl.Enabled;
  132. end;
  133.  
  134. function TRichEditX.Get_Font: Font;
  135. begin
  136.   GetOleFont(FDelphiControl.Font, Result);
  137. end;
  138.  
  139. function TRichEditX.Get_HideScrollBars: WordBool;
  140. begin
  141.   Result := FDelphiControl.HideScrollBars;
  142. end;
  143.  
  144. function TRichEditX.Get_HideSelection: WordBool;
  145. begin
  146.   Result := FDelphiControl.HideSelection;
  147. end;
  148.  
  149. function TRichEditX.Get_ImeName: WideString;
  150. begin
  151.   Result := WideString(FDelphiControl.ImeName);
  152. end;
  153.  
  154. function TRichEditX.Get_Lines: IStrings;
  155. begin
  156.   GetOleStrings(FDelphiControl.Lines, Result);
  157. end;
  158.  
  159. function TRichEditX.Get_MaxLength: Integer;
  160. begin
  161.   Result := FDelphiControl.MaxLength;
  162. end;
  163.  
  164. function TRichEditX.Get_Modified: WordBool;
  165. begin
  166.   Result := FDelphiControl.Modified;
  167. end;
  168.  
  169. function TRichEditX.Get_ParentColor: WordBool;
  170. begin
  171.   Result := FDelphiControl.ParentColor;
  172. end;
  173.  
  174. function TRichEditX.Get_PlainText: WordBool;
  175. begin
  176.   Result := FDelphiControl.PlainText;
  177. end;
  178.  
  179. function TRichEditX.Get_ReadOnly: WordBool;
  180. begin
  181.   Result := FDelphiControl.ReadOnly;
  182. end;
  183.  
  184. function TRichEditX.Get_SelLength: Integer;
  185. begin
  186.   Result := FDelphiControl.SelLength;
  187. end;
  188.  
  189. function TRichEditX.Get_SelStart: Integer;
  190. begin
  191.   Result := FDelphiControl.SelStart;
  192. end;
  193.  
  194. function TRichEditX.Get_SelText: WideString;
  195. begin
  196.   Result := WideString(FDelphiControl.SelText);
  197. end;
  198.  
  199. function TRichEditX.Get_Text: WideString;
  200. begin
  201.   Result := WideString(FDelphiControl.Text);
  202. end;
  203.  
  204. function TRichEditX.Get_Visible: WordBool;
  205. begin
  206.   Result := FDelphiControl.Visible;
  207. end;
  208.  
  209. function TRichEditX.Get_WantReturns: WordBool;
  210. begin
  211.   Result := FDelphiControl.WantReturns;
  212. end;
  213.  
  214. function TRichEditX.Get_WantTabs: WordBool;
  215. begin
  216.   Result := FDelphiControl.WantTabs;
  217. end;
  218.  
  219. function TRichEditX.Get_WordWrap: WordBool;
  220. begin
  221.   Result := FDelphiControl.WordWrap;
  222. end;
  223.  
  224. procedure TRichEditX.AboutBox;
  225. begin
  226.   ShowRichEditXAbout;
  227. end;
  228.  
  229. procedure TRichEditX.Clear;
  230. begin
  231.  
  232. end;
  233.  
  234. procedure TRichEditX.ClearSelection;
  235. begin
  236.  
  237. end;
  238.  
  239. procedure TRichEditX.CopyToClipboard;
  240. begin
  241.  
  242. end;
  243.  
  244. procedure TRichEditX.CutToClipboard;
  245. begin
  246.  
  247. end;
  248.  
  249. procedure TRichEditX.PasteFromClipboard;
  250. begin
  251.  
  252. end;
  253.  
  254. procedure TRichEditX.Print(const Caption: WideString);
  255. begin
  256.  
  257. end;
  258.  
  259. procedure TRichEditX.SelectAll;
  260. begin
  261.  
  262. end;
  263.  
  264. procedure TRichEditX.Set_Color(Value: TColor);
  265. begin
  266.   FDelphiControl.Color := Value;
  267. end;
  268.  
  269. procedure TRichEditX.Set_Ctl3D(Value: WordBool);
  270. begin
  271.   FDelphiControl.Ctl3D := Value;
  272. end;
  273.  
  274. procedure TRichEditX.Set_Cursor(Value: Smallint);
  275. begin
  276.   FDelphiControl.Cursor := TCursor(Value);
  277. end;
  278.  
  279. procedure TRichEditX.Set_DragCursor(Value: Smallint);
  280. begin
  281.   FDelphiControl.DragCursor := TCursor(Value);
  282. end;
  283.  
  284. procedure TRichEditX.Set_Enabled(Value: WordBool);
  285. begin
  286.   FDelphiControl.Enabled := Value;
  287. end;
  288.  
  289. procedure TRichEditX.Set_Font(const Value: Font);
  290. begin
  291.   SetOleFont(FDelphiControl.Font, Value);
  292. end;
  293.  
  294. procedure TRichEditX.Set_HideScrollBars(Value: WordBool);
  295. begin
  296.   FDelphiControl.HideScrollBars := Value;
  297. end;
  298.  
  299. procedure TRichEditX.Set_HideSelection(Value: WordBool);
  300. begin
  301.   FDelphiControl.HideSelection := Value;
  302. end;
  303.  
  304. procedure TRichEditX.Set_ImeName(const Value: WideString);
  305. begin
  306.   FDelphiControl.ImeName := TImeName(Value);
  307. end;
  308.  
  309. procedure TRichEditX.Set_Lines(const Value: IStrings);
  310. begin
  311.   SetOleStrings(FDelphiControl.Lines, Value);
  312. end;
  313.  
  314. procedure TRichEditX.Set_MaxLength(Value: Integer);
  315. begin
  316.   FDelphiControl.MaxLength := Value;
  317. end;
  318.  
  319. procedure TRichEditX.Set_Modified(Value: WordBool);
  320. begin
  321.   FDelphiControl.Modified := Value;
  322. end;
  323.  
  324. procedure TRichEditX.Set_ParentColor(Value: WordBool);
  325. begin
  326.   FDelphiControl.ParentColor := Value;
  327. end;
  328.  
  329. procedure TRichEditX.Set_PlainText(Value: WordBool);
  330. begin
  331.   FDelphiControl.PlainText := Value;
  332. end;
  333.  
  334. procedure TRichEditX.Set_ReadOnly(Value: WordBool);
  335. begin
  336.   FDelphiControl.ReadOnly := Value;
  337. end;
  338.  
  339. procedure TRichEditX.Set_SelLength(Value: Integer);
  340. begin
  341.   FDelphiControl.SelLength := Value;
  342. end;
  343.  
  344. procedure TRichEditX.Set_SelStart(Value: Integer);
  345. begin
  346.   FDelphiControl.SelStart := Value;
  347. end;
  348.  
  349. procedure TRichEditX.Set_SelText(const Value: WideString);
  350. begin
  351.   FDelphiControl.SelText := String(Value);
  352. end;
  353.  
  354. procedure TRichEditX.Set_Text(const Value: WideString);
  355. begin
  356.   FDelphiControl.Text := TCaption(Value);
  357. end;
  358.  
  359. procedure TRichEditX.Set_Visible(Value: WordBool);
  360. begin
  361.   FDelphiControl.Visible := Value;
  362. end;
  363.  
  364. procedure TRichEditX.Set_WantReturns(Value: WordBool);
  365. begin
  366.   FDelphiControl.WantReturns := Value;
  367. end;
  368.  
  369. procedure TRichEditX.Set_WantTabs(Value: WordBool);
  370. begin
  371.   FDelphiControl.WantTabs := Value;
  372. end;
  373.  
  374. procedure TRichEditX.Set_WordWrap(Value: WordBool);
  375. begin
  376.   FDelphiControl.WordWrap := Value;
  377. end;
  378.  
  379. procedure TRichEditX.ChangeEvent(Sender: TObject);
  380. begin
  381.   if FEvents <> nil then FEvents.OnChange;
  382. end;
  383.  
  384. procedure TRichEditX.KeyPressEvent(Sender: TObject; var Key: Char);
  385. var
  386.   TempKey: Smallint;
  387. begin
  388.   TempKey := Smallint(Key);
  389.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  390.   Key := Char(TempKey);
  391. end;
  392.  
  393. procedure TRichEditX.ProtectChangeEvent(Sender: TObject; StartPos,
  394.   EndPos: Integer; var AllowChange: Boolean);
  395. var
  396.   TempAllowChange: WordBool;
  397. begin
  398.   TempAllowChange := WordBool(AllowChange);
  399.   if FEvents <> nil then FEvents.OnProtectChange(StartPos, EndPos, TempAllowChange);
  400.   AllowChange := Boolean(TempAllowChange);
  401. end;
  402.  
  403. procedure TRichEditX.SaveClipboardEvent(Sender: TObject; NumObjects,
  404.   NumChars: Integer; var SaveClipboard: Boolean);
  405. var
  406.   TempSaveClipboard: WordBool;
  407. begin
  408.   TempSaveClipboard := WordBool(SaveClipboard);
  409.   if FEvents <> nil then FEvents.OnSaveClipboard(NumObjects, NumChars, TempSaveClipboard);
  410.   SaveClipboard := Boolean(TempSaveClipboard);
  411. end;
  412.  
  413. procedure TRichEditX.SelectionChangeEvent(Sender: TObject);
  414. begin
  415.   if FEvents <> nil then FEvents.OnSelectionChange;
  416. end;
  417.  
  418. initialization
  419.   TActiveXControlFactory.Create(
  420.     ComServer,
  421.     TRichEditX,
  422.     TRichEdit,
  423.     Class_RichEditX,
  424.     19,
  425.     '{5A5659B6-7975-11D0-BE02-00A024D1875C}');
  426. end.
  427.